home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STREAMS.SWG / 0006_Simple STREAM Example.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  4KB  |  190 lines
  1. {
  2. This program example will demonstrate how to save your
  3. desktop using a stream.  It will give you the ability
  4. to insert windows on the destop and save the state in a
  5. .DSK file and load them from the file to restore its'
  6. state.  Streams REQURE registration of decendant object
  7. types.  Many fall folly to using objects in a stream
  8. that have not been registered.
  9.  
  10. }
  11.  
  12. Program Simple_Stream;
  13.  
  14. Uses Objects, Drivers, Views, Menus, App;
  15.  
  16. Type
  17.   PMyApp = ^MyApp;
  18.   MyApp = Object(TApplication)
  19.      Constructor Init;
  20.      Procedure InitStatusLine; Virtual;
  21.      Procedure InitMenuBar; Virtual;
  22.      Procedure HandleEvent(var Event: TEvent); Virtual;
  23.      Procedure NewWindow;
  24.      Destructor Done; Virtual;
  25.   End;
  26.  
  27.   PMyWindow = ^TMyWindow;
  28.   TMyWindow = Object(TWindow)
  29.      Constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  30.   End;
  31.  
  32.   PMyDeskTop = ^TMyDeskTop;
  33.   TMyDeskTop = object(TDeskTop)
  34.      Windw: PMyWindow;
  35.      Constructor Load(var S:TBufStream);
  36.      Procedure Store(var S: TBufStream); Virtual;
  37.   End;
  38.  
  39. Const
  40.   cmNewWin   = 101;
  41.   cmSaveDesk = 102;
  42.   cmLoadDesk = 103;
  43.  
  44.   RMyDeskTop: TstreamRec = (
  45.      ObjType : 1001;
  46.      VmtLink : Ofs(TypeOf(TMyDeskTop)^);
  47.      Load    : @TMyDeskTop.Load;
  48.      Store   : @TMyDeskTop.Store
  49.   );
  50.  
  51.   RMyWindow: TstreamRec = (
  52.      ObjType : 1002;
  53.      VmtLink : Ofs(TypeOf(TMyWindow)^);
  54.      Load    : @TMyWindow.Load;
  55.      Store   : @TMyWindow.Store
  56.   );
  57.  
  58. Procedure SaveDeskStream;
  59. Var
  60.   SaveFile:TBufStream;
  61. Begin
  62.   SaveFile.Init('Rdesk.dsk',stCreate,1024);
  63.   SaveFile.Put(DeskTop);
  64.   If Savefile.Status <>0 then
  65.     write('Bad Save',Savefile.Status);
  66.   SaveFile.Done;
  67. End;
  68.  
  69. Procedure LoadDeskStream;
  70. Var
  71.   SaveFile:TBufStream;
  72. Begin
  73.   SaveFile.Init('Rdesk.dsk',stOpen,1024);
  74.   DeskTop^.insert(PMyDeskTop(SaveFile.Get));
  75.   If Savefile.Status <>0 then
  76.     write('Bad Load',Savefile.Status)
  77.   else
  78.     DeskTop^.ReDraw;
  79.   SaveFile.Done;
  80. End;
  81.  
  82. { ** MyApp **}
  83. Constructor MyApp.Init;
  84. Begin
  85.   TApplication.Init;
  86.   RegisterType(RMyDesktop);
  87.   RegisterType(RDesktop);
  88.   RegisterType(Rwindow);
  89.   RegisterType(RMywindow);
  90.   RegisterType(RFrame);
  91.   RegisterType(RMenuBar);
  92.   RegisterType(RStatusLine);
  93.   RegisterType(RBackground);
  94. End;
  95.  
  96. Destructor MyApp.Done;
  97. Begin
  98.   TApplication.Done;
  99. End;
  100.  
  101. Procedure MyApp.InitMenuBar;
  102. Var
  103.   R: TRect;
  104. Begin
  105.   GetExtent(R);
  106.   R.B.Y := R.A.Y + 1;
  107.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  108.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  109.     NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  110.     NewLine(
  111.        NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  112.        Nil)))),
  113.     NewSubMenu('~D~eskTop', hcNoContext, NewMenu(
  114.        NewItem('~S~ave Desktop','',kbF2,cmSaveDesk,hcNoContext,
  115.        NewItem('~L~oad Desktop','',kbF3,cmLoadDesk,hcNoContext,
  116.     nil))),nil)))));
  117. End;
  118.  
  119. Procedure MyApp.InitStatusLine;
  120. Var
  121.   R: TRect;
  122. Begin
  123.   GetExtent(R);
  124.   R.A.Y := R.B.Y - 1;
  125.   StatusLine := New(PStatusLine, Init(R,
  126.   NewStatusDef(0, $FFFF,
  127.     NewStatusKey('', kbF10, cmMenu,
  128.     NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  129.     NewStatusKey('~F4~ New', kbF4, cmNewWin,
  130.     NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  131.     nil)))),
  132.   nil)));
  133. End;
  134.  
  135. Procedure MyApp.HandleEvent(var Event: TEvent);
  136. Begin
  137.   TApplication.HandleEvent(Event);
  138.   if Event.What = evCommand then
  139.     Begin
  140.       Case Event.Command of
  141.         cmNewWin: NewWindow;
  142.         cmSaveDesk:SaveDeskStream;
  143.         cmLoadDesk:LoadDeskStream;
  144.       else
  145.         Exit;
  146.       End;
  147.       ClearEvent(Event);
  148.     End;
  149. End;
  150.  
  151. Procedure MyApp.NewWindow;
  152. Var
  153.   Window:PMyWindow;
  154.   R: TRect;
  155. Begin
  156.   R.Assign(0, 0, 24, 7);
  157.   R.Move(Random(55), Random(16));
  158.   Window := New(PMyWindow, Init(R, 'Demo Window', 1));
  159.   DeskTop^.Insert(Window);
  160. End;
  161.  
  162. { ** MyDeskTop **}
  163. Constructor TMyDeskTop.Load(Var S: TBufStream);
  164. Begin
  165.   TDeskTop.Load(S);
  166.   GetSubViewPtr(S,Windw);
  167. End;
  168.  
  169. Procedure TMyDeskTop.Store(Var S: TBufStream);
  170. Begin
  171.   TDeskTop.Store(S);
  172.   PutSubViewPtr(S,Windw);
  173. End;
  174.  
  175. { ** MyWindow **}
  176. Constructor TMyWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  177. Begin
  178.   TWindow.init(Bounds,WinTitle,WindowNo);
  179. End;
  180.  
  181. { Main Program }
  182. Var
  183.   MyTApp:MyApp;
  184.  
  185. Begin
  186.   MyTApp.Init;
  187.   MyTApp.Run;
  188.   MyTApp.Done;
  189. End.
  190.